home *** CD-ROM | disk | FTP | other *** search
/ PC Graphics Unleashed / PC Graphics Unleashed.iso / ch18 / rad386 / dxf2rad.lsp < prev    next >
Encoding:
Text File  |  1994-04-18  |  15.5 KB  |  479 lines
  1. ; This program runs through the current drawing finding all objects that it
  2. ; can extract to a Radiance input file. The layer information is used as the
  3. ; material type in Radiance
  4. ; The following mappings are implemented at the moment
  5. ; AutoCAD   to   Radiance
  6. ; 3DFACE    --   polygon
  7. ; LINE      --   polygon
  8. ; CIRCLE    --   cylinder
  9. ; 3DLINE    --   cylinder
  10. ; POINT     --   sphere
  11. ;
  12. ; Load the program into AutoCAD by typing the following from Command:
  13. ;
  14. ; (load "acad2rad")
  15. ;
  16. ; Run by typing this command from the AutoCAD Command:
  17. ;
  18. ; acad2rad
  19. ;
  20. ; Also included is a utility called xpld. This program runs through the
  21. ; drawing exploding all polylines into their component lines and 3dfaces
  22. ; Run by typing
  23. ;
  24. ; xpld
  25. ;
  26. ; by Robert Amor on 12-Aug-90, final tidyup 22-Oct-90
  27. ; Mail:   School of Architecture
  28. ;         Victoria University of Wellington
  29. ;         PO Box 600
  30. ;         Wellington
  31. ;         New Zealand
  32. ; Phone:  +64 4 721 000 x8008
  33. ; FAX:    +64 4 712 070
  34. ; E-mail: trebor@comp.vuw.ac.nz
  35.  
  36. ;==============================================
  37. ; Get all the 3D faces from the current drawing
  38.  
  39. (defun get3dface (fname)
  40.   ; ssget extracts all entities of a certain type ie 3DFACE
  41.   (setq faces (ssget "X" (list (cons 0 "3DFACE"))))
  42.   ; make sure that some faces exist
  43.   (cond ((/= faces nil)
  44.     ; find out how many entities there are in the set
  45.     (setq slen (sslength faces))
  46.     (princ "3DFACE: ")
  47.     (princ slen)
  48.     (princ " being processed.\n")
  49.     ; loop through each face found, extract the right info and print it
  50.     (setq obj 0)
  51.     (while (< obj slen)
  52.       (faceproc faces obj)
  53.       (setq obj (1+ obj))
  54.       )
  55.     )
  56.   (t nil)
  57.   )
  58. )
  59.  
  60. ;----------------------------------------------------------------------
  61. ; For each 3DFACE in the set, get the layer info and its 4 co-ordinates
  62.  
  63. (defun faceproc (faces obj)
  64.   ; find the object number of this face
  65.   (setq face (ssname faces obj))
  66.   ; get the list of attributes for this face
  67.   (setq fdata (entget face))
  68.   ; find the layer in the list, remember that the elements in
  69.   ; the list are keyed by the DXF file numbers for the attribute
  70.   (setq layer (cdr (assoc 8 fdata)))
  71.   ; find points 1 through 4 from the list
  72.   (setq p1 (cdr (assoc 10 fdata)))
  73.   (setq p2 (cdr (assoc 11 fdata)))
  74.   (setq p3 (cdr (assoc 12 fdata)))
  75.   (setq p4 (cdr (assoc 13 fdata)))
  76.   ; print out all the extracted information
  77.   (prinfaces layer p1 p2 p3 p4 obj fname)
  78. )
  79.  
  80. ;-------------------------------------------
  81. ; Print out the info from a face to the file
  82.  
  83. (defun prinfaces (layer p1 p2 p3 p4 obj fname)
  84.   ; print the layer name as a material type in Radiance
  85.   (princ layer fname)
  86.   ; print the object type, and construct a unique number for it
  87.   (princ " polygon poly_" fname)
  88.   (princ (1+ obj) fname)
  89.   (princ "\n" fname)
  90.   ; print the info lines as specified in Radiance manual for polygon
  91.   (princ "0\n" fname)
  92.   (princ "0\n" fname)
  93.   (princ "12\n" fname)
  94.   ; process each point seperately
  95.   (prinpoint p1 fname)
  96.   (prinpoint p2 fname)
  97.   (prinpoint p3 fname)
  98.   (prinpoint p4 fname)
  99.   (princ "\n" fname)
  100. )
  101.  
  102. ;=======================================================================
  103. ; Get all the circles from the current drawing, turn them into cylinders
  104. ; NOTE: circle must have thickness  thickness=radius of cylinder
  105.  
  106. (defun getcircle (fname)
  107.   ; ssget extracts all entities of a certain type ie CIRCLE
  108.   (setq circles (ssget "X" (list (cons 0 "CIRCLE"))))
  109.   (cond ((/= circles nil)
  110.     ; find out how many entities there are in the set
  111.     (setq slen (sslength circles))
  112.     (princ "CIRCLE: ")
  113.     (princ slen)
  114.     (princ " being processed.\n")
  115.     ; loop through each circle found, extract the right info and print it
  116.     (setq obj 0)
  117.     (while (< obj slen)
  118.       (circleproc circles obj)
  119.       (setq obj (1+ obj))
  120.       )
  121.     )
  122.   (t nil)
  123.   )
  124. )
  125.  
  126. ;--------------------------------------------------------------------
  127. ; For each CIRCLE in the set, get the layer info and its co-ordinates
  128.  
  129. (defun circleproc (circles obj)
  130.   ; find the object number of this circle
  131.   (setq circle (ssname circles obj))
  132.   ; get the list of attributes for this circle
  133.   (setq cdata (entget circle))
  134.   ; find the thickness of the circle to generate the ring radius
  135.   ; remember that the elements in
  136.   ; the list are keyed by the DXF file numbers for the attribute
  137.   (setq thickness (cdr (assoc 39 cdata)))
  138.   ; check thickness is greater than 0
  139.   (cond ((> thickness 0)
  140.     ; find the layer the circle is on
  141.     (setq layer (cdr (assoc 8 cdata)))
  142.     ; find center of circle
  143.     (setq p1 (cdr (assoc 10 cdata)))
  144.     ; find the radius of the circle
  145.     (setq radius (cdr (assoc 40 cdata)))
  146.     ; find the plane normal of the circle
  147.     (setq plane (cdr (assoc 210 cdata)))
  148.     ; print out all the extracted information
  149.     (princircles layer thickness p1 radius plane obj fname)
  150.     )
  151.   (t nil)
  152.   )
  153. )
  154.  
  155. ;------------------------------------------------
  156. ; Print out the info from the circles to the file
  157.  
  158. (defun princircles (layer thickness p1 radius plane obj fname)
  159.   ; print the layer name as a material type in Radiance
  160.   (princ layer fname)
  161.   ; print the object type, and construct a unique number for it
  162.   (princ " cylinder cyl_circ_" fname)
  163.   (princ (1+ obj) fname)
  164.   (princ "\n" fname)
  165.   ; print the info lines as specified in Radiance manual for ring
  166.   (princ "0\n" fname)
  167.   (princ "0\n" fname)
  168.   (princ "7\n" fname)
  169.   ; print one end of the cylinder
  170.   (prinpoint p1 fname)
  171.   ; find the length of the cylinder by multiplying the thickness by the normal vector
  172.   (setq lv (list (* thickness (car plane)) (* thickness (cadr plane)) (* thickness (caddr plane))))
  173.   ; add the width to the previous point to find the end of the cylinder
  174.   (setq p2 (list (+ (car p1) (car lv)) (+ (cadr p1) (cadr lv)) (+ (caddr p1) (caddr lv))))
  175.   (prinpoint p2 fname)
  176.   (princ "   " fname)
  177.   (princ thickness fname)
  178.   (princ "\n" fname)
  179.   (princ "\n" fname)
  180. )
  181.  
  182. ;===================================================================
  183. ; Get all 3dlines from the current drawing, turn them into cylinders
  184. ; NOTE: line must have thickness  thickness=radius  line=centreline
  185.  
  186. (defun get3dline (fname)
  187.   ;ssget extracts all entities of a certain type ie 3DLINE
  188.   (setq lines (ssget "X" (list (cons 0 "3DLINE" ))))
  189.   (cond ((/= lines nil)
  190.     ;find out how many entities there are in the set
  191.     (setq slen (sslength lines))
  192.     (princ "3DLINE: ")
  193.     (princ slen)
  194.     (princ " being processed.\n")
  195.     ;loop through each line found, extract the right info and print
  196.     (setq obj 0)
  197.     (while (< obj slen)
  198.       (line3dproc lines obj)
  199.       (setq obj (1+ obj))
  200.       )
  201.     )
  202.   (t nil)
  203.   )
  204. )
  205.  
  206. ;-------------------------------------------------------------------
  207. ; for each 3DLINE in the set, get the layer info and its coordinates
  208.  
  209. (defun line3dproc (lines obj)
  210.   ; find the object number of this line
  211.   (setq line (ssname lines obj))
  212.   ;get the list of attributes for this line
  213.   (setq ldata (entget line))
  214.   ; find the thickness of the line to generate the cylinder radius
  215.   ; remember that elements in the list are keyed
  216.   ; by the DXF file numbers for the attribute
  217.   (setq thickness (cdr (assoc 39 ldata)))
  218.   ; check thickness of line is greater than 0
  219.   (cond ((> thickness 0)
  220.     ; find the layer of this line
  221.     (setq layer (cdr (assoc 8 ldata)))
  222.     ;find startpoint of line
  223.     (setq p1 (cdr (assoc 10 ldata)))
  224.     ;find endpoint of line
  225.     (setq p2 (cdr (assoc 11 ldata)))
  226.     ; print out all the extracted information
  227.     (prin3dlines layer p1 p2 thickness obj fname)
  228.     )
  229.   (t nil)
  230.   )
  231. )
  232.  
  233. ;----------------------------------------------
  234. ;Print out the info from the 3dlines to the files
  235.  
  236. (defun prin3dlines (layer p1 p2 thickness obj fname)
  237.   ; print the layer name as a material type in Radiance
  238.   (princ layer fname)
  239.   ; print the object type and construct a unique number for it
  240.   (princ " cylinder cyl_3d_" fname)
  241.   (princ (1+ obj) fname)
  242.   (princ "\n" fname)
  243.   ; print the info lines as specified in Radiance manual for cylinder
  244.   (princ "0\n" fname)
  245.   (princ "0\n" fname)
  246.   (princ "7\n" fname)
  247.   ;process each point separately
  248.   (prinpoint p1 fname)
  249.   (prinpoint p2 fname)
  250.   (princ "   " fname)
  251.   (princ thickness fname)
  252.   (princ "\n\n" fname)
  253. )
  254.  
  255. ;================================================================
  256. ; Get all points from the current drawing, turn them into spheres
  257. ; NOTE: point must have thickness  thickness=radius
  258.  
  259. (defun getpoint (fname)
  260.   ;ssget extracts all entities of a certain type ie POINT
  261.   (setq points (ssget "X" (list (cons 0 "POINT" ))))
  262.   (cond ((/= points nil)
  263.     ;find out how many entities there are in the set
  264.     (setq slen (sslength points))
  265.     (princ "POINT: ")
  266.     (princ slen)
  267.     (princ " being processed.\n")
  268.     ;loop through each point found, extract the right info and print
  269.     (setq obj 0)
  270.     (while (< obj slen)
  271.       (pointproc points obj)
  272.       (setq obj (1+ obj))
  273.       )
  274.     )
  275.   (t nil)
  276.   )
  277. )
  278.  
  279. ;-------------------------------------------------------------------
  280. ; for each POINT in the set, get the layer info and its coordinates
  281.  
  282. (defun pointproc (points obj)
  283.   ; find the object number of this point
  284.   (setq point (ssname points obj))
  285.   ;get the list of attributes for this point
  286.   (setq pdata (entget point))
  287.   ; find the thickness of the point to generate the sphere radius
  288.   ; remember that elements in the list are keyed
  289.   ; by the DXF file numbers for the attribute
  290.   (setq thickness (cdr (assoc 39 pdata)))
  291.   ; check thickness of point is greater than 0
  292.   (cond ((> thickness 0)
  293.     ; find the layer of this point
  294.     (setq layer (cdr (assoc 8 pdata)))
  295.     ;find center of point
  296.     (setq p1 (cdr (assoc 10 pdata)))
  297.     ; print out all the extracted information
  298.     (prinpoints layer p1 thickness obj fname)
  299.     )
  300.   (t nil)
  301.   )
  302. )
  303.  
  304. ;--------------------------------------------
  305. ; Print out the info from a point to the file
  306.  
  307. (defun prinpoints (layer p1 thickness obj fname)
  308.   ; print the layer name as a material type in Radiance
  309.   (princ layer fname)
  310.   ; print the object type and construct a unique number for it
  311.   (princ " sphere sphere_" fname)
  312.   (princ (1+ obj) fname)
  313.   (princ "\n" fname)
  314.   ; print the info lines as specified in Radiance manual for sphere
  315.   (princ "0\n" fname)
  316.   (princ "0\n" fname)
  317.   (princ "4\n" fname)
  318.   ; print out the center of the sphere
  319.   (prinpoint p1 fname)
  320.   (princ "   " fname)
  321.   (princ thickness fname)
  322.   (princ "\n\n" fname)
  323. )
  324.  
  325. ;========================================================================
  326. ; Get all lines from the current drawing, turn them into 3d-faces
  327. ; NOTE: line must have thickness  thickness=width of face in direction of
  328. ;       line normal
  329.  
  330. (defun getline (fname)
  331.   ;ssget extracts all entities of a certain type ie LINE
  332.   (setq lines (ssget "X" (list (cons 0 "LINE" ))))
  333.   (cond ((/= lines nil)
  334.     ;find out how many entities there are in the set
  335.     (setq slen (sslength lines))
  336.     (princ "LINE: ")
  337.     (princ slen)
  338.     (princ " being processed.\n")
  339.     ;loop through each line found, extract the right info and print
  340.     (setq obj 0)
  341.     (while (< obj slen)
  342.       (lineproc lines obj)
  343.       (setq obj (1+ obj))
  344.       )
  345.     )
  346.   (t nil)
  347.   )
  348. )
  349.  
  350. ;-------------------------------------------------------------------
  351. ; for each LINE in the set, get the layer info and its coordinates
  352.  
  353. (defun lineproc (lines obj)
  354.   ; find the object number of this line
  355.   (setq line (ssname lines obj))
  356.   ;get the list of attributes for this line
  357.   (setq ldata (entget line))
  358.   ; find the thickness of the line to generate the width of the face
  359.   ; remember that elements in the list are keyed
  360.   ; by the DXF file numbers for the attribute
  361.   (setq thickness (cdr (assoc 39 ldata)))
  362.   ; check thickness of line is greater than 0
  363.   (cond ((> thickness 0)
  364.     ; find the layer of this line
  365.     (setq layer (cdr (assoc 8 ldata)))
  366.     ;find startpoint of line
  367.     (setq p1 (cdr (assoc 10 ldata)))
  368.     ;find endpoint of line
  369.     (setq p2 (cdr (assoc 11 ldata)))
  370.     ; get the normal vector of the thickness
  371.     (setq normal (cdr (assoc 210 ldata)))
  372.     ; print out all the extracted information
  373.     (prinlines layer p1 p2 thickness normal obj fname)
  374.     )
  375.   (t nil)
  376.   )
  377. )
  378.  
  379. ;----------------------------------------------
  380. ;Print out the info from the lines to the files
  381.  
  382. (defun prinlines (layer p1 p2 thickness normal obj fname)
  383.   ; print the layer name as a material type in Radiance
  384.   (princ layer fname)
  385.   ; print the object type and construct a unique number for it
  386.   (princ " polygon thick_line_" fname)
  387.   (princ (1+ obj) fname)
  388.   (princ "\n" fname)
  389.   ; print the info lines as specified in Radiance manual for polygon
  390.   (princ "0\n" fname)
  391.   (princ "0\n" fname)
  392.   (princ "12\n" fname)
  393.   ;process each point separately
  394.   (prinpoint p1 fname)
  395.   (prinpoint p2 fname)
  396.   ; find the width of the face by multiplying the thickness by the normal vector
  397.   (setq lv (list (* thickness (car normal)) (* thickness (cadr normal)) (* thickness (caddr normal))))
  398.   ; add the width to the previous point to find the third point on the face
  399.   (setq p3 (list (+ (car p2) (car lv)) (+ (cadr p2) (cadr lv)) (+ (caddr p2) (caddr lv))))
  400.   ; add the width to the first point to find the last point on the face
  401.   (setq p4 (list (+ (car p1) (car lv)) (+ (cadr p1) (cadr lv)) (+ (caddr p1) (caddr lv))))
  402.   (prinpoint p3 fname)
  403.   (prinpoint p4 fname)
  404.   (princ "\n" fname)
  405. )
  406.  
  407. ;==================================================================
  408. ; Print out the info for a single point, ie a list of three numbers
  409. ; in the Radiance style
  410.  
  411. (defun prinpoint (point fname)
  412.   (princ "   " fname)
  413.   ; print out the x co-ordinate
  414.   (princ (car point) fname)
  415.   (princ "   " fname)
  416.   ; print out the y co-ordinate
  417.   (princ (cadr point) fname)
  418.   (princ "   " fname)
  419.   ; print out the z co-ordinate
  420.   (princ (caddr point) fname)
  421.   (princ "\n" fname)
  422. )
  423.  
  424. ;===========================================================================
  425. ; Define a procedure to explode a polyline into its component lines or faces
  426.  
  427. (defun polyproc (polys obj)
  428.   ; find the object number of this polyline
  429.   (setq poly (ssname polys obj))
  430.   ; explode the polyline into its components
  431.   (command "explode" poly)
  432. )
  433.  
  434. (defun C:XPLD ()
  435.   ; ssget extracts all entities of a certain type ie POLYLINE
  436.   (setq polys (ssget "X" (list (cons 0 "POLYLINE"))))
  437.   ; make sure that some polys exist
  438.   (cond ((/= polys nil)
  439.     ; find out how many entities there are in the set
  440.     (setq slen (sslength polys))
  441.     (princ "POLYLINE: ")
  442.     (princ slen)
  443.     (princ " being exploded.\n")
  444.     ; loop through each poly found, extract the right info and explode it
  445.     (setq obj 0)
  446.     (while (< obj slen)
  447.       (polyproc polys obj)
  448.       (setq obj (1+ obj))
  449.       )
  450.     )
  451.   (t
  452.    (princ "No POLYLINE\n"))
  453.   )
  454. )
  455.  
  456. ;============================================================
  457. ; Process the drawing file, ask for a file name to create and
  458. ; process the types defined,
  459.  
  460. (defun C:ACAD2RAD ()
  461.   ; get the name of the file to create
  462.   (setq file (getstring "\nWhat Radiance file to create: "))
  463.   ; open the file to write to
  464.   (setq fname (open file "w"))
  465.   ; process all supported types
  466.   (get3dface fname)
  467.   (getcircle fname)
  468.   (get3dline fname)
  469.   (getpoint  fname)
  470.   (getline   fname)
  471.   ; ALL NEW PROCEDURES TO EXTRACT OTHER TYPES OF OBJECTS FROM AUTOCAD
  472.   ; SHOULD BE CALLED FROM HERE, AND FOLLOW THE STRUCTURE OF THE
  473.   ; PROCEDURES DEFINED ABOVE
  474.   ;
  475.   (princ "Done\n")
  476.   ; close the file after we have finished writing everything to it
  477.   (close fname)
  478. )
  479.